home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb9.arc / HEAPTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1985-12-11  |  3KB  |  82 lines
  1. program HeapTest (input, output) ;
  2.  
  3. {  This program demonstrates a bug in Turbo's version 2.  Put
  4.    10 integers on the stack, then release the stack and put
  5.    10 integers on the stack again.  In version 1.0, you will
  6.    get the same results - as it should be.  In version 2.0,
  7.    you will get different answers.  Apparently, the procedure
  8.    Release(HeapTop) in not working properly.   The procedure
  9.    ReleaseHeap is a replacement for Release (HeapTop) and seems
  10.    to work correctly.  }
  11.  
  12. type
  13.   IntegerPointer = ^integer ;
  14. var
  15.   Number  : ^integer ;
  16.   HeapTop : ^integer ;
  17.   Mem     :  real    ;
  18.  
  19. Procedure ReleaseHeap (AHeapPointer : IntegerPointer) ;
  20. var
  21.   i : integer ;
  22. begin
  23.   i := ((seg(heapptr^) - seg(AHeapPointer^)) shl 4) +
  24.         (ofs(heapptr^) - ofs(AHeapPointer^)) ;
  25.     FreeMem(AHeapPointer, i) ;
  26.   end ;
  27.  
  28. procedure report ;    { report memory available }
  29. begin
  30.   Mem := memAvail ;
  31.   if (Mem < 0) then Mem := 65536.0 + MemAvail ;
  32.   write ('MemAvail = ', Mem :7:0, ' paragraphs ', Mem * 16.0 :9:0, ' bytes') ;
  33. end ;
  34.  
  35. procedure FillTheHeap(xc,yc, Depth : integer) ;   { fill the heap to depth }
  36. var
  37.   n : integer ;
  38. begin
  39.   for n := 1 to Depth do
  40.     begin
  41.       New(Number) ;
  42.       Number^ := n ;
  43.       gotoxy(xc,yc) ;
  44.       report ;
  45.     end ;
  46.   end ;
  47.  
  48. begin   { main }
  49.   clrscr;
  50.   writeln('  This program demonstrates a bug in Turbo version 2.  Put');
  51.   writeln('   10 integers on the stack, then release the stack and put ');
  52.   writeln('   10 integers on the stack again.  In version 1.0, you will');
  53.   writeln('   get the same results - as it should be.  In version 2.0, ');
  54.   writeln('   you will get different answers.  Apparently, the procedure');
  55.   writeln('   Release(HeapTop) in not working properly.   The procedure ');
  56.   writeln('   ReleaseHeap is a replacement for Release (HeapTop) and seems');
  57.   writeln('   to work correctly.  Try your version by replacing the call to');
  58.   writeln('   ReleaseHeap with Release.  Turbo version 3.x works with both.');
  59.   writeln('   The heap operations have functioned properly when the memavail');
  60.   writeln('   in the third and fourth lines are equal to the first and second');
  61.   writeln('   lines respectively.');
  62.   writeln;
  63.   writeln;
  64.   Mark(HeapTop) ;         { mark the top of the heap }
  65.   gotoxy(5,20) ;
  66.   write('1:  ');
  67.   report ;                { 1: report memory available }
  68.   write('2:  ');
  69.   FillTheHeap(5,21,10) ;  { 2: fill the heap with 10 integers }
  70.   {*********************** Change these two calls **********************}
  71.   ReleaseHeap(HeapTop) ;  { release the heap using the fix }
  72.   { release (HeapTop) ;} { This does not work! }
  73.   {*********************** to test you turbo version *******************}
  74.   gotoxy(5,22) ;
  75.   write('3:  ');
  76.   report ;                { 3: report memory available;  should be same as 1 }
  77.   write('4:  ');
  78.   FillTheHeap(5,23,10) ;  { 4: put 10 integers on again; should be same as 2 }
  79. end.
  80.  
  81.  
  82.